home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / MWCC03.ZIP / RTL.ZIP / MCOMMDLG.PAS next >
Pascal/Delphi Source File  |  1993-08-18  |  29KB  |  982 lines
  1. {**********************************************************************}
  2. {*                                                                    *}
  3. {*          Microworks Custom Control Object Library                            *}
  4. {*                                                                    *}
  5. {*         Version 1.03                                                     *}
  6. {*                                                                    *}
  7. {*     Object Windows Library Extension for Borland Pascal v7.0       *}
  8. {*                                                                    *}
  9. {*     and Turbo Pascal for Windows v 1.5                             *}
  10. {*                                                                    *}
  11. {*         MCommDlg : Common Dialog Unit                                      *}
  12. {*                                                                    *}
  13. {*     Copyright 1992-93 Microworks (Jeff Franks) Sydney, Australia.  *}
  14. {*                                                                    *}
  15. {**********************************************************************}
  16.  
  17. unit MCommDlg;
  18.  
  19. {$C MOVEABLE DEMANDLOAD DISCARDABLE}
  20.  
  21. interface
  22.  
  23. uses Wintypes, WinProcs, CommDlg, MObjects,
  24.          {$IFDEF Ver15}
  25.              WObjects;
  26.          {$ELSE}
  27.              Objects, OWindows, ODialogs;
  28.          {$ENDIF}
  29.  
  30. type
  31.  
  32.     {********** Font Dialog **********}
  33.  
  34.     PFontStatic = ^TFontStatic;
  35.     TFontStatic = object(TStatic)
  36.         CRect : TRect;
  37.         function  GetColor (Color: PChar): LongInt; virtual;
  38.         function  CheckRect: Integer; virtual;
  39.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  40.     end;
  41.  
  42.     PFontGroupBox = ^TFontGroupBox;
  43.     TFontGroupBox = object(TGroupBox)
  44.         constructor InitResource (AParent: PWindowsObject; AnId: Integer; AText: PChar);
  45.         procedure SetupWindow; virtual;
  46.         procedure WMCtlColor (var Msg: TMessage); virtual wm_First + wm_CtlColor;
  47.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  48.     private
  49.         Stat1 : PMWCCStatic;
  50.         Stat2 : PFontStatic;
  51.         CRect : TRect;
  52.     end;
  53.  
  54.     PFontComboBox = ^TFontComboBox;
  55.     TFontComboBox = object(TMWCCComboBox)
  56.         procedure WMCommand (var Msg: TMessage); virtual wm_First + wm_Command;
  57.     end;
  58.  
  59.     PFontCheckBox = ^TFontCheckBox;
  60.     TFontCheckBox = object(TMWCCCheckBox)
  61.         procedure BMSetCheck (var Msg: TMessage); virtual wm_First + bm_SetCheck;
  62.     end;
  63.  
  64.     PChooseFontDlg = ^TChooseFontDlg;
  65.     TChooseFontDlg = object(TDialog)
  66.         OkBtn, CancelBtn : PMWCCBmpButton;
  67.         constructor Init (AParent: PWindowsObject; AName: PChar; FData: PChooseFont);
  68.         function  Create: Boolean; virtual;
  69.         function  Execute: Integer; virtual;
  70.         procedure SetUpWindow; virtual;
  71.         procedure PrepareFontData; virtual;
  72.         procedure WMCtlColor (var Msg: TMessage); virtual wm_First + wm_CtlColor;
  73.         procedure WMDrawItem (var msg :TMessage); virtual wm_First + wm_DrawItem;
  74.         procedure Ok (var msg :TMessage); virtual id_First + id_Ok;
  75.         procedure Cancel (var msg :TMessage); virtual id_First + id_Cancel;
  76.     private
  77.         BMP, BkBrush       : HBitmap;
  78.         CRect              : TRect;
  79.         CB1, CB2, CB3, CB4 : PFontComboBox;
  80.         GB1                : PMWCCGroupBox;
  81.         GB2                : PFontGroupBox;
  82.         Check1, Check2     : PFontCheckBox;
  83.     end;
  84.  
  85.     PMWCCFontDlg = ^TMWCCFontDlg;
  86.     TMWCCFontDlg = object(TChooseFontDlg)
  87.         constructor Init (AParent: PWindowsObject; AName: PChar; FData: PChooseFont; ABmp: PChar);
  88.         destructor Done; virtual;
  89.         function     GetClassName : PChar; virtual;
  90.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  91.     end;
  92.  
  93.     PSFXFontDlg = ^TSFXFontDlg;
  94.     TSFXFontDlg = object(TChooseFontDlg)
  95.         constructor Init (AParent: PWindowsObject; AName: PChar; FData: PChooseFont);
  96.         destructor Done; virtual;
  97.         function     GetClassName : PChar; virtual;
  98.         procedure SetUpWindow; virtual;
  99.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  100.         procedure WMNCPaint (var Msg: TMessage); virtual wm_First + wm_NCPaint;
  101.         procedure WMNCCalcSize (var Msg: TMessage); virtual wm_First + wm_NCCalcSize;
  102.         procedure WMActivate (var Msg: TMessage); virtual wm_First + wm_Activate;
  103.         procedure WMNCActivate (var Msg: TMessage); virtual wm_First + wm_NCActivate;
  104.         procedure WMActivateApp (var Msg: TMessage); virtual wm_First + wm_ActivateApp;
  105.         procedure WMGetMinMaxInfo (var Msg: TMessage); virtual wm_First + wm_GetMinMaxInfo;
  106.     private
  107.         WinRect : TRect;
  108.         szTitle : array[0..144] of char;
  109.     end;
  110.  
  111.     {********** Filename Dialog **********}
  112.  
  113.     PFileNameDlg = ^TFileNameDlg;
  114.     TFileNameDlg = object(TDialog)
  115.         FilePath         : array[0..255] of Char;
  116.         FileTitle        : array[0..12] of Char;
  117.         OpenFileName     : TOpenFileName;
  118.         OkBtn, CancelBtn : PMWCCBmpButton;
  119.         constructor Init(AParent: PWindowsObject; AName: PChar; IsOpen: Boolean);
  120.         function Create: Boolean; virtual;
  121.         function Execute: Integer; virtual;
  122.         function DlgTitle: PChar; virtual;
  123.         function DefSpec: PChar; virtual;
  124.     function DefExt: PChar; virtual;
  125.     function DefSpecPos: Byte; virtual;
  126.         function OpenFlags: Longint; virtual;
  127.         function DoExec: Boolean; virtual;
  128.         procedure WMCtlColor (var Msg: TMessage); virtual wm_First + wm_CtlColor;
  129.         procedure WMDrawItem (var msg :TMessage); virtual wm_First + wm_DrawItem;
  130.         procedure Ok(var msg :TMessage); virtual id_First + id_Ok;
  131.         procedure Cancel(var msg :TMessage); virtual id_First + id_Cancel;
  132.     private
  133.         BMP, BkBrush : HBitmap;
  134.         CBox         : PMWCCCheckBox;
  135.         CB1, CB2     : PMWCCComboBox;
  136.         EC           : PMWCCEdit;
  137.         LB1, LB2        : PMWCCListBox;
  138.         Open         : Boolean;
  139.     end;
  140.  
  141.     PMWCCFileNameDlg = ^TMWCCFileNameDlg;
  142.     TMWCCFileNameDlg = object(TFileNameDlg)
  143.         constructor Init (AParent: PWindowsObject; AName, ABmp: PChar; IsOpen: Boolean);
  144.         destructor Done; virtual;
  145.         function     GetClassName : PChar; virtual;
  146.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  147.     private
  148.         CRect : TRect;
  149.         ST    : PMWCCEdit;
  150.     end;
  151.  
  152.     PSFXFileNameDlg = ^TSFXFileNameDlg;
  153.     TSFXFileNameDlg = object(TFileNameDlg)
  154.         constructor Init (AParent: PWindowsObject; AName: PChar; IsOpen: Boolean);
  155.         destructor Done; virtual;
  156.         function     GetClassName : PChar; virtual;
  157.         procedure SetUpWindow; virtual;
  158.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  159.         procedure WMNCPaint (var Msg: TMessage); virtual wm_First + wm_NCPaint;
  160.         procedure WMNCCalcSize (var Msg: TMessage); virtual wm_First + wm_NCCalcSize;
  161.         procedure WMActivate (var Msg: TMessage); virtual wm_First + wm_Activate;
  162.         procedure WMNCActivate (var Msg: TMessage); virtual wm_First + wm_NCActivate;
  163.         procedure WMActivateApp (var Msg: TMessage); virtual wm_First + wm_ActivateApp;
  164.         procedure WMGetMinMaxInfo (var Msg: TMessage); virtual wm_First + wm_GetMinMaxInfo;
  165.     private
  166.         WinRect : TRect;
  167.         szTitle : array[0..144] of char;
  168.     end;
  169.  
  170. implementation
  171.  
  172. const
  173.  
  174.     idw_Stat1      = 56;
  175.     idw_Stat2      = 57;
  176.     HLib : THandle = 0;
  177.  
  178. var
  179.  
  180.     ColorRef : TColorRef;
  181.     FontData : PChooseFont;
  182.     FontText : PChar;
  183.  
  184. {********** TChooseFontDlg **********}
  185.  
  186. constructor TChooseFontDlg.Init(AParent: PWindowsObject; AName: PChar; Fdata: PChooseFont);
  187. begin
  188.     TDialog.Init(AParent, AName);
  189.     DisableTransfer;
  190.     FontData  := FData;
  191.     CB1       := New(PFontComboBox, InitResource(@Self, 1136, 21));
  192.     CB2       := New(PFontComboBox, InitResource(@Self, 1137, 21));
  193.     CB3       := New(PFontComboBox, InitResource(@Self, 1138, 21));
  194.     CB4       := New(PFontComboBox, InitResource(@Self, 1139, 21));
  195.     GB1       := New(PMWCCGroupBox, InitResource(@Self, 1072, ' Effects'));
  196.     GB2       := New(PFontGroupBox, InitResource(@Self, 1073, ' Sample'));
  197.     Check1    := New(PFontCheckBox, InitResource(@Self, 1040));
  198.     Check2    := New(PFontCheckBox, InitResource(@Self, 1041));
  199.     if GetSystemMetrics(sm_CYSize) = 26 then
  200.     begin
  201.         OkBtn := New(PMWCCBmpButton, Init(@Self, id_Ok, 556, 34, False, 1, ctl_Flush));
  202.         CancelBtn := New(PMWCCBmpButton, Init(@Self, id_Cancel, 556, 126, False, 2, ctl_Flush));
  203.     end
  204.     else
  205.     begin
  206.         OkBtn := New(PMWCCBmpButton, Init(@Self, id_ok, 424, 28, False, 1, ctl_Flush));
  207.         CancelBtn := New(PMWCCBmpButton, Init(@Self, id_cancel, 424, 104, False, 2, ctl_Flush))